{$S+}
program stockmarket;
type
        share=record
          amount:0..500;
          value:integer[7];
        end;
        stock=record
                name:string[20];
                value:share;
                dividend:integer;
              end;
        player=record
                name:string[10];
                value:array[1..10] of share;
                dividend,turn:integer;
                cash:integer[10];
               end;
        table=(bear,bull);
var
        market:array[table] of array[2..10] of array[2..12] of integer;
        stocks:array[1..10] of stock;
        players:array[1..9] of player;
        num:string[3];
        ch:char;
        hi,lo1,lo2,seed,currentp,currents,year:integer;
        nplayer:1..9;

procedure clear_screen;
begin
   write ( chr ( 27 ), chr ( 69 ) ) ;  {H-19 specific   gws}
end;

procedure clear_line;
begin
   write ( chr ( 27 ), chr ( 75 ) );  {H-19 specific    gws}
end;

procedure clear;
begin
  gotoxy(0,16);
  writeln('                                                                ');
  writeln('                                                                ');
  writeln('                                                                ');
  gotoxy(0,16)
end;

function number:integer;
var     n,i:integer;
begin
n:=0;
for i:=1 to length(num) do
  if ord(num[i])>47 then
    if ord(num[i])<58 then
      n:=n*10+(ord(num[i])-48)
    else
      begin
        clear;
        writeln('          Type digits please.');
        n:=0
      end;
number:=n;
end;

function upper(cha:char):char;
begin
  if ord(cha)>96 then if ord(cha)<123 then upper:=chr(ord(cha)-32)
    else upper:=cha else upper:=cha;
end;

procedure gameconst;
var     i,j:integer;
        k:table;
        f:interactive;
begin   reset(f,'#5:STOCK.DATA.TEXT');
        writeln('Stocks:':20,'Dividends per year');
        for i:=1 to 10 do
          begin
            readln(f,stocks[i].name);
            readln(f,stocks[i].dividend);
            writeln(stocks[i].name:20,stocks[i].dividend:4);
          end;
        for k:=bear to bull do
        for j:=2 to 10 do
          begin
            for i:=2 to 12 do read(f,market[k,j,i]);
            readln(f);
          end;
        close(f);
  end;

procedure initialize;
var     i,j:integer;
begin
        for i:= 1 to 10 do
          begin
            if i=1 then 
              begin
                stocks[i].value.amount:=50;
                stocks[i].value.value:=1000
              end
            else
              begin
                stocks[i].value.amount:=500;
                stocks[i].value.value:=100;
              end;
        if i<10 then
          begin
            for j:=1 to 10 do
              begin
                players[i].value[j].amount:=0;
                players[i].value[j].value:=0;
                players[i].dividend:=0;
                players[i].turn:=i;
                players[i].cash:=5000;
              end;
          end;
       end;
  end;

procedure playersname;
var     i,j:integer;
begin
        write('How many players (1..9)?');
        read(ch);
        nplayer:=ord(ch)-48;
        writeln;
        for i:=1 to nplayer do
          begin
            write('Enter name of player ',i:1,' ');
            readln(players[i].name);
            if length(players[i].name)=0 then i:=i-1;
          end;
end;

function random:real;
 begin
  random := seed/32767;
  seed := ( 103 * seed + 1999 ) mod 32767;
  if seed < 0 then seed := seed * ( -1 );
end; {random}

function irandom(low,high:integer):integer;
{irandom produces integer numbers
ranging from low to high}
        begin irandom:=trunc(random*(high-low+0.9)+low) end;

function dieroll:integer;
        begin dieroll:=irandom(1,6) end;

procedure game;
var     i,j,k:integer;
 
 procedure disstock(i:integer);
        begin
          gotoxy(0,i+3);
          writeln(stocks[i].name:20
                ,stocks[i].value.value:4,stocks[i].value.amount:4);
        end;

 procedure shostock;
 var     i:integer;
        begin
          clear_screen;
          writeln('                    Year 198',year:1);
          writeln('Stock');
          gotoxy(18,2);
          writeln('Value Avail');
          for i:=1 to 10 do disstock(i);
        end;

 procedure update;
 var     j,k:integer;
        i:table;

procedure split(k:integer);
var     i,j:integer;
begin {split}
          stocks[k].value.value:=stocks[k].value.value div 2;
          for i:=1 to nplayer do
            for j:=1 to nplayer do
              if i=players[j].turn then
                begin
                  if players[j].value[k].amount<= stocks[k].value.amount then
                    begin
                      stocks[k].value.amount:=stocks[k].value.amount-
                        players[j].value[k].amount;
                      players[j].value[k].amount:=players[j].value[k].amount 
                        * 2
                    end
               else
                 begin
                   players[j].cash:=players[j].cash+
                     ((players[j].value[k].amount-stocks[k].value.amount)
                     *stocks[k].value.value);
                   players[j].value[k].amount:=players[j].value[k].amount
                     +stocks[k].value.amount;
                   stocks[k].value.amount:=0
                 end
               end;
end; {split}

procedure paydiv;
var     play,stoq:integer;
begin
for play:=1 to 9 do
  begin
    players[play].dividend:=0;
    for stoq:=1 to 10 do
      begin
        players[play].value[stoq].value:=players[play].value[stoq].amount
          *stocks[stoq].value.value;
        if stocks[stoq].value.value>49 then
          players[play].dividend:=players[play].dividend
            +players[play].value[stoq].amount*stocks[stoq].dividend
      end;
  players[play].cash:=players[play].cash+players[play].dividend;
  end;
end;

procedure bust(stoq:integer);
var     i:integer;
begin
  stocks[stoq].value.value:=0;
  stocks[stoq].value.amount:=0;
  for i:=1 to nplayer do
    begin
      players[i].value[stoq].amount:=0;
      players[i].value[stoq].value:=0
    end;
end;

begin {update}
          if irandom(1,2)=1 then i:=bull else i:=bear;
          j:=dieroll+dieroll;
          for k:=2 to 10 do
          begin
            if stocks[k].value.value=0 then
              begin
                stocks[k].value.amount:=500;
                stocks[k].value.value:=100
              end;
            stocks[k].value.value:=stocks[k].value.value+market[i,k,j];
            if stocks[k].value.value>150 then split(k);
            if stocks[k].value.value<1 then bust(k);
          end;
          paydiv;
          shostock;
        end; {update}

 procedure plystock(play,stoq:integer);
        begin
          gotoxy(30,stoq+3);
          writeln(players[play].value[stoq].amount:4,
                  players[play].value[stoq].value:6);
        end;

 procedure shoplay(play:integer);
 var     i:integer;
        begin
          gotoxy(28,1);
          writeln(players[play].name:10);
          gotoxy(30,2);
          writeln('Shares Value');
          for i:=1 to 10 do plystock(play,i);
          gotoxy(24,14);
          writeln('Dividends ',players[play].dividend:6);
          gotoxy(29,15);
          writeln('Cash ',players[play].cash:6);
          clear
        end;

 procedure seturn;
 var     i,r,x:integer;
        begin
          for i:=1 to nplayer do
            begin
              r:=irandom(1,nplayer);
              x:=players[i].turn;
              players[i].turn:=players[r].turn;
              players[r].turn:=x;
            end;
        end;

procedure transak(play,tran,stoq:integer);
var     n:integer;
begin
  gotoxy(0,16);
  clear_line;
  If tran<0 then write('Sell ') else write('Buy ');
  write('how many shares of ',stocks[stoq].name);
  readln(num);
  n:=number;
  if tran<0 then 
    begin
     if players[play].value[stoq].amount<n then
       begin
         gotoxy(0,16);
         clear_line;
         writeln('You do not have ',n,' shares to sell.')
       end
     else
       begin
         players[play].cash:=players[play].cash+n*stocks[stoq].value.value;
         stocks[stoq].value.amount:=stocks[stoq].value.amount+n;
         players[play].value[stoq].amount:=players[play].value[stoq].amount
           -n;
         players[play].value[stoq].value:=players[play].value[stoq].amount
           *stocks[stoq].value.value;
         gotoxy(29,15);
         writeln('Cash ',players[play].cash:6);
         disstock(stoq);
         plystock(play,stoq)
       end
     end
 else
   begin
     if stocks[stoq].value.amount<n then
       begin
         gotoxy(0,16);
         clear_line;
         writeln('There are not ',n,' shares on the open market')
       end
     else
       if players[play].cash<stocks[stoq].value.value*n then
         begin
           gotoxy(0,16);
           clear_line;
           writeln('You do not have the cash to buy.')
         end
       else
         begin
           players[play].cash:=players[play].cash-n
             *stocks[stoq].value.value;
           players[play].value[stoq].amount:=players[play].value[stoq].amount
             +n;
           stocks[stoq].value.amount:=stocks[stoq].value.amount-n;
           players[play].value[stoq].value:=players[play].value[stoq].amount
             *stocks[stoq].value.value;
           gotoxy(29,15);
           writeln('Cash ',players[play].cash:6);
           disstock(stoq);
           plystock(play,stoq)
         end;
     end;
  end;

procedure getstk(play,tran:integer);
var     i:integer;
begin
  gotoxy(0,16);
  clear_line;
  if tran<0 then write('Sell ') else write('Buy ');
  write('which stock (type first letter)');
  read(ch);
  ch:=upper(ch);
  for i:=1 to 10 do if ch=stocks[i].name[1] then transak(play,tran,i);
end;

procedure playturn(play:integer);
var     i,j:integer;
begin
  shoplay(play);
  repeat
    gotoxy(0,17);
    clear_line;
    write(players[play].name:10,' B(uy, S(ell, F(inished');
    read(ch);
    ch:=upper(ch);
    i:=0;
    if ch='S' then i:=-1;
    if ch='B' then i:=1;
    if i<>0 then getstk(play,i)
  until ch='F';
end;

begin {game}
        for year:=0 to 9 do
          begin
            update;
            seturn;
            for i:=1 to nplayer do
              for j:=1 to nplayer do
                if i=players[j].turn then playturn(j);
          end;
end; {game}

procedure finish;
var     cash:integer[10];
        play,stoq:integer;
begin
  clear_screen;
  for play:=1 to nplayer do
    begin
      cash:=players[play].cash;
      for stoq:=1 to 10 do
        begin
          cash:=cash+players[play].value[stoq].value
        end;
      writeln(players[play].name:10,' $',cash:10)
    end;
end;

begin{stockmarket}
        clear_screen;
        time ( hi, lo1 );
        for hi := 1 to 1000 do ;
        time ( hi, lo2 );
        if lo2 = lo1 then 
           begin
              write ( 'no clock, please type an integer ' );
              readln ( seed );
           end
        else seed := lo2;
        clear_screen;
        gameconst;
        playersname;
        initialize;
        game;
        finish;
end. {stockmarket}

